#load required packages
library(tidyverse)
library(leaflet)
library(sp)
library(sf)
library(rgdal)
#Data Manipulation
#load data
df <- read_csv('jan_dec.csv')
Parsed with column specification:
cols(
.default = col_double(),
tpep_pickup_datetime = [34mcol_datetime(format = "")[39m,
tpep_dropoff_datetime = [34mcol_datetime(format = "")[39m,
store_and_fwd_flag = [31mcol_character()[39m
)
See spec(...) for full column specifications.
#replace Inf values with 0
df <- do.call(data.frame,lapply(df, function(x) replace(x, is.infinite(x),0)))
Error in as.POSIXct.numeric(value) : 'origin' must be supplied
#replace Inf values with 0
df <- df %>%
mutate(avg_mph = ifelse(avg_mph == Inf, 0, avg_mph))
#Data by Pickup Zone
df_pu <- df %>%
group_by(PULocationID) %>%
summarize(passenger_count = mean(passenger_count),
fare_amount = mean(fare_amount),
trip_distance = mean(trip_distance),
extra = mean(extra),
mta_tax = mean(mta_tax),
tip_amount = mean(tip_amount),
tolls_amount = mean(tolls_amount),
total_amount = mean(total_amount),
fare_by_dist = mean(fare_by_dist),
duration = mean(duration),
avg_mph = mean(avg_mph),
adj_total = mean(adj_total))
#Within Zone Data
df_within <- df %>%
filter(PULocationID == DOLocationID) %>%
group_by(PULocationID) %>%
summarize(passenger_count = mean(passenger_count),
fare_amount = mean(fare_amount),
trip_distance = mean(trip_distance),
extra = mean(extra),
mta_tax = mean(mta_tax),
tip_amount = mean(tip_amount),
tolls_amount = mean(tolls_amount),
total_amount = mean(total_amount),
fare_by_dist = mean(fare_by_dist),
duration = mean(duration),
avg_mph = mean(avg_mph),
adj_total = mean(adj_total))
#Pickup Volume Data
df_volume <- df %>%
group_by(PULocationID) %>%
tally()
taxi_zones <- readOGR("taxi_zones/taxi_zones.shp")
OGR data source with driver: ESRI Shapefile
Source: "/Users/athvedt/Documents/GitHub/Data Visualization/Group_W/taxi_zones/taxi_zones.shp", layer: "taxi_zones"
with 263 features
It has 6 fields
#transform polygon
proj <- spTransform(taxi_zones, '+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs')
Map 1 - Average Tip by Pickup Zone
content <- paste("Neighborhood:", taxi_zones$zone, "<br/>",
"Average Tip:", "$", round(df_pu$tip_amount, digits = 2), "<br/>")
bins <- c(0, 1, 2, 3, 4, 5, 15)
pal <- colorBin("Greens", domain = df_pu$tip_amount, bins = bins)
leaflet(df_pu) %>%
addTiles() %>%
setView(lng = -73.98928, lat = 40.75042, zoom = 10.2) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = proj,
popup = content,
weight = 1,
fillColor = ~pal(df_pu$tip_amount),
fillOpacity = 1,
highlightOptions = highlightOptions(
color='#000000',
weight = 3,
bringToFront = TRUE,
sendToBack = TRUE),
label = taxi_zones$zone) %>%
addLegend("topright",
pal = pal,
values = df_pu$tip_amount,
title = "Average Credit Card Tip (USD)",
opacity = 1,
labFormat = labelFormat(prefix = "$"))
Map 2 - Average Speed
#Issues - No data for certain zones, shows “NA” on map
content <- paste("Neighborhood:", taxi_zones$zone, "<br/>",
"Average Speed (MPH):", round(df_within$avg_mph, digits = 5), "<br/>")
leaflet(df_within) %>%
addTiles() %>%
setView(lng = -73.98928, lat = 40.75042, zoom = 10.2) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = proj,
popup = content,
weight = 1,
fillColor = ~colorQuantile("RdYlGn", df_within$avg_mph)(df_within$avg_mph),
fillOpacity = 1,
highlightOptions = highlightOptions(
color='#000000',
weight = 3,
bringToFront = TRUE,
sendToBack = TRUE),
label = taxi_zones$zone) %>%
addLegend("topright",
pal = colorQuantile("RdYlGn", df_within$avg_mph, n = 5),
values = df_within$avg_mph,
title = "Average Speed (Percentile)",
opacity = 1,)
Map 3 - Pickup Volume
content <- paste("Neighborhood:", taxi_zones$zone, "<br/>",
"Number of Pickups", df_volume$n, "<br/>")
leaflet(df_volume) %>%
addTiles() %>%
setView(lng = -73.98928, lat = 40.75042, zoom = 10.2) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data = proj,
popup = content,
weight = 1,
fillColor = ~colorQuantile("YlOrRd", df_volume$n)(df_volume$n),
fillOpacity = 1,
highlightOptions = highlightOptions(
color='#000000',
weight = 3,
bringToFront = TRUE,
sendToBack = TRUE),
label = taxi_zones$zone) %>%
addLegend("topright",
pal = colorQuantile("YlOrRd", df_volume$n, n = 5),
values = df_volume$n,
title = "Pickup Volume Percentile",
opacity = 1,)
LS0tCnRpdGxlOiAiRmluYWwgUHJvamVjdCIKYXV0aG9yOiAiQW5kcmV3IFRodmVkdCIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQpgYGB7cn0KI2xvYWQgcmVxdWlyZWQgcGFja2FnZXMKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkobGVhZmxldCkKbGlicmFyeShzcCkKbGlicmFyeShzZikKbGlicmFyeShyZ2RhbCkKYGBgCiNEYXRhIE1hbmlwdWxhdGlvbgpgYGB7cn0KI2xvYWQgZGF0YQpkZiA8LSByZWFkX2NzdignamFuX2RlYy5jc3YnKQpgYGAKYGBge3J9CiNyZXBsYWNlIEluZiB2YWx1ZXMgd2l0aCAwCmRmIDwtICBkby5jYWxsKGRhdGEuZnJhbWUsbGFwcGx5KGRmLCBmdW5jdGlvbih4KSByZXBsYWNlKHgsIGlzLmluZmluaXRlKHgpLDApKSkKCmBgYApgYGB7cn0KI3JlcGxhY2UgSW5mIHZhbHVlcyB3aXRoIDAKZGYgPC0gZGYgJT4lCiAgbXV0YXRlKGF2Z19tcGggPSBpZmVsc2UoYXZnX21waCA9PSBJbmYsIDAsIGF2Z19tcGgpKQpgYGAKCgojRGF0YSBieSBQaWNrdXAgWm9uZQpgYGB7cn0KZGZfcHUgPC0gZGYgJT4lCiAgZ3JvdXBfYnkoUFVMb2NhdGlvbklEKSAlPiUKICBzdW1tYXJpemUocGFzc2VuZ2VyX2NvdW50ID0gbWVhbihwYXNzZW5nZXJfY291bnQpLAogICAgICAgICAgICBmYXJlX2Ftb3VudCA9IG1lYW4oZmFyZV9hbW91bnQpLAogICAgICAgICAgICB0cmlwX2Rpc3RhbmNlID0gbWVhbih0cmlwX2Rpc3RhbmNlKSwKICAgICAgICAgICAgZXh0cmEgPSBtZWFuKGV4dHJhKSwKICAgICAgICAgICAgbXRhX3RheCA9IG1lYW4obXRhX3RheCksCiAgICAgICAgICAgIHRpcF9hbW91bnQgPSBtZWFuKHRpcF9hbW91bnQpLAogICAgICAgICAgICB0b2xsc19hbW91bnQgPSBtZWFuKHRvbGxzX2Ftb3VudCksCiAgICAgICAgICAgIHRvdGFsX2Ftb3VudCA9IG1lYW4odG90YWxfYW1vdW50KSwKICAgICAgICAgICAgZmFyZV9ieV9kaXN0ID0gbWVhbihmYXJlX2J5X2Rpc3QpLAogICAgICAgICAgICBkdXJhdGlvbiA9IG1lYW4oZHVyYXRpb24pLAogICAgICAgICAgICBhdmdfbXBoID0gbWVhbihhdmdfbXBoKSwKICAgICAgICAgICAgYWRqX3RvdGFsID0gbWVhbihhZGpfdG90YWwpKQpgYGAKCiNXaXRoaW4gWm9uZSBEYXRhCmBgYHtyfQpkZl93aXRoaW4gPC0gZGYgJT4lCiAgZmlsdGVyKFBVTG9jYXRpb25JRCA9PSBET0xvY2F0aW9uSUQpICU+JQogICAgZ3JvdXBfYnkoUFVMb2NhdGlvbklEKSAlPiUKICBzdW1tYXJpemUocGFzc2VuZ2VyX2NvdW50ID0gbWVhbihwYXNzZW5nZXJfY291bnQpLAogICAgICAgICAgICBmYXJlX2Ftb3VudCA9IG1lYW4oZmFyZV9hbW91bnQpLAogICAgICAgICAgICB0cmlwX2Rpc3RhbmNlID0gbWVhbih0cmlwX2Rpc3RhbmNlKSwKICAgICAgICAgICAgZXh0cmEgPSBtZWFuKGV4dHJhKSwKICAgICAgICAgICAgbXRhX3RheCA9IG1lYW4obXRhX3RheCksCiAgICAgICAgICAgIHRpcF9hbW91bnQgPSBtZWFuKHRpcF9hbW91bnQpLAogICAgICAgICAgICB0b2xsc19hbW91bnQgPSBtZWFuKHRvbGxzX2Ftb3VudCksCiAgICAgICAgICAgIHRvdGFsX2Ftb3VudCA9IG1lYW4odG90YWxfYW1vdW50KSwKICAgICAgICAgICAgZmFyZV9ieV9kaXN0ID0gbWVhbihmYXJlX2J5X2Rpc3QpLAogICAgICAgICAgICBkdXJhdGlvbiA9IG1lYW4oZHVyYXRpb24pLAogICAgICAgICAgICBhdmdfbXBoID0gbWVhbihhdmdfbXBoKSwKICAgICAgICAgICAgYWRqX3RvdGFsID0gbWVhbihhZGpfdG90YWwpKQpgYGAKCiNQaWNrdXAgVm9sdW1lIERhdGEKYGBge3J9CmRmX3ZvbHVtZSA8LSBkZiAlPiUKICBncm91cF9ieShQVUxvY2F0aW9uSUQpICU+JQogIHRhbGx5KCkKYGBgCgoKYGBge3J9CnRheGlfem9uZXMgPC0gcmVhZE9HUigidGF4aV96b25lcy90YXhpX3pvbmVzLnNocCIpCmBgYApgYGB7cn0KI3RyYW5zZm9ybSBwb2x5Z29uCnByb2ogPC0gc3BUcmFuc2Zvcm0odGF4aV96b25lcywgJytwcm9qPWxvbmdsYXQgK2VsbHBzPVdHUzg0ICtkYXR1bT1XR1M4NCArbm9fZGVmcycpCmBgYAoKIyMgTWFwIDEgLSBBdmVyYWdlIFRpcCBieSBQaWNrdXAgWm9uZQoKYGBge3J9CmNvbnRlbnQgPC0gcGFzdGUoIk5laWdoYm9yaG9vZDoiLCB0YXhpX3pvbmVzJHpvbmUsICI8YnIvPiIsCiAgICAgICAgICAgICAgICAgIkF2ZXJhZ2UgVGlwOiIsICIkIiwgcm91bmQoZGZfcHUkdGlwX2Ftb3VudCwgZGlnaXRzID0gMiksICI8YnIvPiIpCgpiaW5zIDwtIGMoMCwgMSwgMiwgMywgNCwgNSwgMTUpCnBhbCA8LSBjb2xvckJpbigiR3JlZW5zIiwgZG9tYWluID0gZGZfcHUkdGlwX2Ftb3VudCwgYmlucyA9IGJpbnMpCgpsZWFmbGV0KGRmX3B1KSAlPiUKICBhZGRUaWxlcygpICU+JQogIHNldFZpZXcobG5nID0gLTczLjk4OTI4LCBsYXQgPSA0MC43NTA0Miwgem9vbSA9IDEwLjIpICU+JQogIGFkZFByb3ZpZGVyVGlsZXMoIkNhcnRvREIuUG9zaXRyb24iKSAlPiUKICBhZGRQb2x5Z29ucyhkYXRhID0gcHJvaiwKICAgICAgICAgICAgICBwb3B1cCA9IGNvbnRlbnQsCiAgICAgICAgICAgICAgd2VpZ2h0ID0gMSwKICAgICAgICAgICAgICBmaWxsQ29sb3IgPSB+cGFsKGRmX3B1JHRpcF9hbW91bnQpLAogICAgICAgICAgICAgIGZpbGxPcGFjaXR5ID0gMSwKICAgICAgICAgICAgICBoaWdobGlnaHRPcHRpb25zID0gaGlnaGxpZ2h0T3B0aW9ucygKICAgICAgICAgICAgICAgIGNvbG9yPScjMDAwMDAwJywKICAgICAgICAgICAgICAgIHdlaWdodCA9IDMsCiAgICAgICAgICAgICAgICBicmluZ1RvRnJvbnQgPSBUUlVFLAogICAgICAgICAgICAgICAgc2VuZFRvQmFjayA9IFRSVUUpLAogICAgICAgICAgICAgIGxhYmVsID0gdGF4aV96b25lcyR6b25lKSAlPiUKICBhZGRMZWdlbmQoInRvcHJpZ2h0IiwKICAgICAgICAgICAgcGFsID0gcGFsLAogICAgICAgICAgICB2YWx1ZXMgPSBkZl9wdSR0aXBfYW1vdW50LAogICAgICAgICAgICB0aXRsZSA9ICJBdmVyYWdlIENyZWRpdCBDYXJkIFRpcCAoVVNEKSIsCiAgICAgICAgICAgIG9wYWNpdHkgPSAxLAogICAgICAgICAgICBsYWJGb3JtYXQgPSBsYWJlbEZvcm1hdChwcmVmaXggPSAiJCIpKQpgYGAKCiMjIE1hcCAyIC0gQXZlcmFnZSBTcGVlZAojSXNzdWVzIC0gTm8gZGF0YSBmb3IgY2VydGFpbiB6b25lcywgc2hvd3MgIk5BIiBvbiBtYXAKYGBge3J9CmNvbnRlbnQgPC0gcGFzdGUoIk5laWdoYm9yaG9vZDoiLCB0YXhpX3pvbmVzJHpvbmUsICI8YnIvPiIsCiAgICAgICAgICAgICAgICAgIkF2ZXJhZ2UgU3BlZWQgKE1QSCk6Iiwgcm91bmQoZGZfd2l0aGluJGF2Z19tcGgsIGRpZ2l0cyA9IDUpLCAiPGJyLz4iKQoKCmxlYWZsZXQoZGZfd2l0aGluKSAlPiUKICBhZGRUaWxlcygpICU+JQogIHNldFZpZXcobG5nID0gLTczLjk4OTI4LCBsYXQgPSA0MC43NTA0Miwgem9vbSA9IDEwLjIpICU+JQogIGFkZFByb3ZpZGVyVGlsZXMoIkNhcnRvREIuUG9zaXRyb24iKSAlPiUKICBhZGRQb2x5Z29ucyhkYXRhID0gcHJvaiwKICAgICAgICAgICAgICBwb3B1cCA9IGNvbnRlbnQsCiAgICAgICAgICAgICAgd2VpZ2h0ID0gMSwKICAgICAgICAgICAgICBmaWxsQ29sb3IgPSB+Y29sb3JRdWFudGlsZSgiUmRZbEduIiwgZGZfd2l0aGluJGF2Z19tcGgpKGRmX3dpdGhpbiRhdmdfbXBoKSwKICAgICAgICAgICAgICBmaWxsT3BhY2l0eSA9IDEsCiAgICAgICAgICAgICAgaGlnaGxpZ2h0T3B0aW9ucyA9IGhpZ2hsaWdodE9wdGlvbnMoCiAgICAgICAgICAgICAgICBjb2xvcj0nIzAwMDAwMCcsCiAgICAgICAgICAgICAgICB3ZWlnaHQgPSAzLAogICAgICAgICAgICAgICAgYnJpbmdUb0Zyb250ID0gVFJVRSwKICAgICAgICAgICAgICAgIHNlbmRUb0JhY2sgPSBUUlVFKSwKICAgICAgICAgICAgICBsYWJlbCA9IHRheGlfem9uZXMkem9uZSkgJT4lCiAgYWRkTGVnZW5kKCJ0b3ByaWdodCIsCiAgICAgICAgICAgIHBhbCA9IGNvbG9yUXVhbnRpbGUoIlJkWWxHbiIsIGRmX3dpdGhpbiRhdmdfbXBoLCBuID0gNSksCiAgICAgICAgICAgIHZhbHVlcyA9IGRmX3dpdGhpbiRhdmdfbXBoLAogICAgICAgICAgICB0aXRsZSA9ICJBdmVyYWdlIFNwZWVkIChQZXJjZW50aWxlKSIsCiAgICAgICAgICAgIG9wYWNpdHkgPSAxLCkKYGBgCiMgTWFwIDMgLSBQaWNrdXAgVm9sdW1lCmBgYHtyfQpjb250ZW50IDwtIHBhc3RlKCJOZWlnaGJvcmhvb2Q6IiwgdGF4aV96b25lcyR6b25lLCAiPGJyLz4iLAogICAgICAgICAgICAgICAgICJOdW1iZXIgb2YgUGlja3VwcyIsIGRmX3ZvbHVtZSRuLCAiPGJyLz4iKQoKCmxlYWZsZXQoZGZfdm9sdW1lKSAlPiUKICBhZGRUaWxlcygpICU+JQogIHNldFZpZXcobG5nID0gLTczLjk4OTI4LCBsYXQgPSA0MC43NTA0Miwgem9vbSA9IDEwLjIpICU+JQogIGFkZFByb3ZpZGVyVGlsZXMoIkNhcnRvREIuUG9zaXRyb24iKSAlPiUKICBhZGRQb2x5Z29ucyhkYXRhID0gcHJvaiwKICAgICAgICAgICAgICBwb3B1cCA9IGNvbnRlbnQsCiAgICAgICAgICAgICAgd2VpZ2h0ID0gMSwKICAgICAgICAgICAgICBmaWxsQ29sb3IgPSB+Y29sb3JRdWFudGlsZSgiWWxPclJkIiwgZGZfdm9sdW1lJG4pKGRmX3ZvbHVtZSRuKSwKICAgICAgICAgICAgICBmaWxsT3BhY2l0eSA9IDEsCiAgICAgICAgICAgICAgaGlnaGxpZ2h0T3B0aW9ucyA9IGhpZ2hsaWdodE9wdGlvbnMoCiAgICAgICAgICAgICAgICBjb2xvcj0nIzAwMDAwMCcsCiAgICAgICAgICAgICAgICB3ZWlnaHQgPSAzLAogICAgICAgICAgICAgICAgYnJpbmdUb0Zyb250ID0gVFJVRSwKICAgICAgICAgICAgICAgIHNlbmRUb0JhY2sgPSBUUlVFKSwKICAgICAgICAgICAgICBsYWJlbCA9IHRheGlfem9uZXMkem9uZSkgJT4lCiAgYWRkTGVnZW5kKCJ0b3ByaWdodCIsCiAgICAgICAgICAgIHBhbCA9IGNvbG9yUXVhbnRpbGUoIllsT3JSZCIsIGRmX3ZvbHVtZSRuLCBuID0gNSksCiAgICAgICAgICAgIHZhbHVlcyA9IGRmX3ZvbHVtZSRuLAogICAgICAgICAgICB0aXRsZSA9ICJQaWNrdXAgVm9sdW1lIFBlcmNlbnRpbGUiLAogICAgICAgICAgICBvcGFjaXR5ID0gMSwpCmBgYAoKYGBge3J9CgpgYGAKCg==